home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRON / 1009.ZIP / HAM2.ARC / CONLOG.BAS < prev    next >
BASIC Source File  |  1987-05-12  |  8KB  |  211 lines
  1. 1  '  CONLOG - a vhf/uhf contest scoring program by G4PMK and G3SEK,
  2. 2  '  based on the program in "Amateur Radio Software" by GM4ANB (RSGB).
  3. 3  '  This version has the following extras -
  4. 4  '    Partially completed log can be saved in a file called LOG.DAT
  5. 5  '    Location input can be either WW or Eu locator, or distance in km.
  6. 6  '    WW locator can use short entry for default field,
  7. 7  '                                            eg "91IP" becomes "IO91IP".
  8. 8  '    Duplicate QSOs are queried on location input.
  9. 9  '    Plus extra editing facilities.
  10. 10 UP$=CHR$(30)  ' IBM cursor-up
  11. 15 BAK$=CHR$(29) ' IBM cursor-back
  12. 20 CLREOL$=STRING$(70,32)+STRING$(70,BAK$) ' Print 70 spaces and backstep
  13. 40 MC=1200:HF$="IO": ' Max. contacts, home locator field; edit if necessary
  14. 50 DIM L$(MC),N(MC): PI=3.14159
  15. 60 GOSUB 1600
  16. 70 PRINT "Use saved log data from LOG.DAT on current drive? (Y/N) : ";
  17. 80 ZZ$=INKEY$:IF ZZ$="" THEN GOTO 80
  18. 90 IF ZZ$<>"y" AND ZZ$<>"Y" THEN GOTO 160
  19. 100 PRINT "Loading log data from LOG.DAT .....":PRINT
  20. 110 OPEN "I",#1,"LOG.DAT"
  21. 120 INPUT #1, OWN.QRA$,CN,TD,TP,DX,BD,BC,OD,OC,PN,PP,PD,PC,E1,N1,SS,P,LOST,DUP
  22. 130 FOR I=1 TO MC
  23. 140 INPUT #1, L$(I),N(I):NEXT I
  24. 150 CLOSE #1:Q$=OWN.QRA$:PRINT:PRINT " Last QSO number ";N(P),"Locator : ";L$(P):PRINT:GOTO 700
  25. 158 '
  26. 159 ' New home locator and initialization
  27. 160 PRINT:PRINT:INPUT "Home locator : ",Q$
  28. 170 OWN.QRA$=Q$
  29. 180 GOSUB 870
  30. 190 IF F>.5 THEN GOTO 160
  31. 200 E1=E:N1=N
  32. 210 CN=1:TD=0:TP=0:DX=0
  33. 220 BD=0:BC=0:OD=0:OC=0
  34. 230 PN=1
  35. 240 PP=0:PD=0:PC=0
  36. 250 PRINT:PRINT "Page ";PN:PRINT
  37. 258 '
  38. 259 ' Input starts here
  39. 260 IF CN<1 THEN CN=1
  40. 265 KM=0
  41. 270 PRINT "QSO No.";CN;" Locator or Distance ";
  42. 280 M=1:INPUT Q$:IF Q$="" THEN GOTO 260
  43. 290 IF Q$=OWN.QRA$ OR HF$+Q$=OWN.QRA$ THEN GOTO 830
  44. 295 IF Q$="0" THEN LOST=LOST+1:DX=0:PT=0:GOTO 610
  45. 300 IF Q$="END" OR Q$="SAVE"  THEN GOTO 1120
  46. 310 IF Q$="PAGE"OR Q$= "TOTAL" THEN GOTO 700
  47. 315 IF Q$="?" THEN GOSUB 1610: GOTO 270
  48. 320 IF LEFT$(Q$,1)<>"-" THEN GOTO 340
  49. 330 M=-1:Q$=MID$(Q$,2):IF Q$="" THEN GOTO 530
  50. 340 F=0:FOR J=1 TO LEN(Q$):T$=MID$(Q$,J,1)
  51. 350 IF(T$<"0" OR T$>"9") AND T$<>"." THEN F=1
  52. 360 NEXT J
  53. 370 IF F>.5 THEN GOTO 400
  54. 378 '
  55. 379 ' Distance hashing
  56. 380 DX=VAL(Q$):IF DX<>0 THEN SS=INT(DX/10)+1000:P=SS:KM=1:GOTO 430
  57. 390 PT=0:GOTO 610
  58. 398 '
  59. 399 ' Distance calculation and locator filing
  60. 400 GOSUB 870:IF F<.5 THEN GOTO 430
  61. 410 PRINT CHR$(7):PRINT"BAD INPUT":GOTO 260
  62. 430 IF N(P)=0 THEN GOTO 570
  63. 440 IF L$(P)<>Q$ THEN GOTO 500
  64. 450 PRINT"Locator same as QSO No. ";N(P);
  65. 460 PRINT"  Is this a duplicate contact? (Y/N) : ";CHR$(7);
  66. 470 ZZ$=INKEY$:IF ZZ$= "" THEN GOTO 470 ELSE PRINT UP$;CLREOL$;
  67. 480 IF ZZ$<>"Y" AND ZZ$<>"y" THEN GOTO 500 ELSE DUP=DUP+1
  68. 490 PT=0:DX=0:GOTO 610
  69. 500 P=P+1:IF P>MC THEN P=1
  70. 510 IF ABS(P-SS)>.5 THEN GOTO 430
  71. 520 PRINT"Locator table full!":PRINT CHR$(7),CHR$(7):END
  72. 528 '
  73. 529 ' Erase a contact
  74. 530 ZZ=1
  75. 535 PRINT "Please wait a moment....."
  76. 540 IF N(ZZ)<>CN-1 THEN ZZ=ZZ+1:IF ZZ>MC THEN GOTO 1260 ELSE GOTO 540
  77. 550 Q$=L$(ZZ):L$(ZZ)="":N(ZZ)=0
  78. 560 PRINT:PRINT CHR$(7); Q$;" Contact number  ";CN-1;" is erased":PRINT:IF ZZ>1000 THEN GOTO 565 ELSE GOSUB 870:GOTO 580
  79. 565 DX=VAL(Q$):GOTO 600
  80. 568 '
  81. 569 ' Subroutine for distance calculation and best DX
  82. 570 L$(P)=Q$:N(P)=CN
  83. 575 IF KM=1 THEN GOTO 600
  84. 580 DX=SIN(N1)*SIN(N) + COS(N1)*COS(N)*COS(E1-E)
  85. 585 TEMP=1-DX*DX:IF TEMP<0 THEN TEMP=0
  86. 590 DX=6367.6*ATN(SQR(TEMP)/DX)
  87. 595 IF DX<1 THEN DX=1
  88. 600 PT=M*(2*INT(DX/50) + 1):DX=M*INT(DX)
  89. 605 IF DX/50=INT(DX/50) THEN PT=PT+(M*-2)
  90. 610 PRINT TAB(44);UP$; DX;"km",PT;" pts"
  91. 620 TD=TD+DX:TP=TP+PT
  92. 630 PD=PD+DX:PP=PP+PT:PC=PC+M
  93. 640 CN=CN+M:IF DX>0 THEN GOTO 670
  94. 650 DX=-DX:IF DX<BD THEN GOTO 260
  95. 660 PRINT"Best DX cancelled":BC=OC:BD=OD:GOTO 260
  96. 670 IF DX<BD THEN GOTO 260
  97. 680 IF CN>2 THEN PRINT"*** New best DX ***"
  98. 690 OD=BD:OC=BC:BD=DX:BC=CN-M:GOTO 260
  99. 698 '
  100. 699 ' End-of-page processing
  101. 700 T=CN-1:PRINT :PRINT TAB(10);"Totals so far:"
  102. 710 PRINT:PRINT T;" QSOs":IF T<1 THEN T=1
  103. 720 PRINT TD;"km",INT(TD/T);"km/QSO"
  104. 730 PRINT TP;" pts",INT(TP*100/T)/100;" pts/QSO"
  105. 735 PRINT:PRINT LOST;" lost QSOs  ";DUP; " duplicate QSOs":PRINT:PRINT
  106. 740 T=PC:PRINT:PRINT"   Subtotals for page ";PN
  107. 750 PRINT T;" QSOs":IF T<1 THEN T=1
  108. 760 PRINT PD;"km",INT(PD/T);"km/QSO"
  109. 770 PRINT PP;" pts",INT(PP*100/T)/100;" pts/QSO"
  110. 780 PRINT:PRINT"Best DX ";BD;"km, QSO No ";BC
  111. 790 PRINT:PRINT"Start a new page?  (Y/N) :"
  112. 800 ZZ$=INKEY$:IF ZZ$="" THEN GOTO 800
  113. 810 IF ZZ$="Y" OR ZZ$="y"THEN PN=PN+1:GOTO 240
  114. 820 GOTO 260
  115. 828 '
  116. 829 ' Local QSO
  117. 830 PRINT CHR$(7); "Really a QSO in your own square? (Y/N)  ";
  118. 840 ZZ$=INKEY$:IF ZZ$="" THEN GOTO 840 ELSE PRINT UP$;CLREOL$;
  119. 850 IF ZZ$<>"Y" AND ZZ$<>"y" THEN GOTO 490
  120. 860 DX=1:GOTO 600
  121. 868 '
  122. 869 ' Subroutine for locator processing
  123. 870 F=1:IF LEN(Q$)=4 THEN Q$=HF$+Q$:PRINT Q$
  124. 875 IF LEN(Q$)=6 THEN GOSUB 1300:RETURN
  125. 879 ' Old QRA locator
  126. 880 IF LEN(Q$)<>5 THEN RETURN
  127. 890 E=60*(ASC(LEFT$(Q$,1))-ASC("A"))
  128. 900 IF (E<0) OR (E>1500) THEN RETURN
  129. 910 N=48*(ASC(MID$(Q$,2,1))-ASC("A"))
  130. 920 IF (N<0) OR (N>1200) THEN RETURN
  131. 930 T$=MID$(Q$,3,1)
  132. 940 IF (T$<"0") OR (T$>"8") THEN RETURN
  133. 950 T$=MID$(Q$,4,1)
  134. 960 IF (T$<"0") OR (T$>"9") THEN RETURN
  135. 970 T=VAL(MID$(Q$,3,2))
  136. 980 IF (T>80) OR (T<1) THEN RETURN
  137. 990 T=(T-1)/10
  138. 1000 N=N+6*(7-INT(T))
  139. 1010 E=E+60*(T-INT(T))
  140. 1020 A$=RIGHT$(Q$,1):IF (A$<"A") OR (A$="I") OR (A$>"J") THEN RETURN
  141. 1030 IF (A$="A") OR (A$="J") OR (A$="E") THEN E=E+2
  142. 1040 IF (A$="B") OR (A$="C") OR (A$="D") THEN E=E+4
  143. 1050 IF (A$="G") OR (A$="J") OR (A$="C") THEN N=N+2
  144. 1060 IF (A$="H") OR (A$="A") OR (A$="B") THEN N=N+4
  145. 1070 N=N+1921:E=E+1
  146. 1080 IF (E>1200) THEN E=E-1560
  147. 1090 E=E*PI/5400
  148. 1100 N=N*PI/8640
  149. 1109 ' Old QRA hashing
  150. 1110 SS=INT(MC*VAL(MID$(Q$,3,2))/99):P=SS:F=0:RETURN
  151. 1118 '
  152. 1119 ' Rewrite file
  153. 1120 PRINT
  154. 1130 PRINT "Saving current log contents in LOG.DAT .....":PRINT
  155. 1140 FI$="LOG.DAT"
  156. 1150 '    OPEN "O",#1,FI$  ' Can't kill an open file in IBM BASIC.
  157. 1160 '    KILL FI$         ' Can't kill a non-existent file either.
  158. 1170 '    CLOSE
  159. 1180 OPEN "O",#1,FI$
  160. 1190 PRINT #1, OWN.QRA$;",";CN;TD;TP;DX;BD;BC;OD;OC;PN;PP;PD;PC;E1;N1;SS;P;LOST;DUP
  161. 1200 FOR I=1 TO MC
  162. 1210 PRINT #1, L$(I);",";N(I)
  163. 1220 NEXT I
  164. 1230 CLOSE
  165. 1240 IF Q$="SAVE" THEN GOTO 250
  166. 1250 END
  167. 1259 '
  168. 1260 PRINT "That must have been a non-scoring contact....."
  169. 1270 CN=CN-1:LOST=LOST-1:PC=PC-1
  170. 1280 GOTO 260
  171. 1298 '
  172. 1299 ' Routine for new world locator (Maidenhead) system
  173. 1300 IF LEN(Q$)<>6 THEN RETURN
  174. 1310 T=1:GOSUB 1400
  175. 1320 E=N+N
  176. 1330 IF F>.5 THEN RETURN
  177. 1340 F=1:T=2:GOSUB 1400
  178. 1350 IF F>.5 THEN RETURN
  179. 1359 ' Maidenhead hashing
  180. 1360 SS=25*(ASC(MID$(Q$,5,1))-ASC("A"))+ASC(MID$(Q$,6,1))-ASC("A")+1
  181. 1370 SS=INT(MC*SS/720):P=SS
  182. 1380 RETURN
  183. 1399 ' Subroutine for Maidenhead
  184. 1400 N=ASC(MID$(Q$,T,1))-ASC("A")
  185. 1410 IF N<0 OR N>17 THEN RETURN
  186. 1420 T$=MID$(Q$,T+2,1)
  187. 1430 IF T$<"0" OR T$>"9" THEN RETURN
  188. 1440 N=N*10+ASC(T$)-ASC("0")
  189. 1450 T$=MID$(Q$,T+4,1)
  190. 1460 IF T$<"A" OR T$>"X" THEN RETURN
  191. 1470 N=N*24+ASC(T$)-ASC("A")
  192. 1480 N=N-2160+.5
  193. 1490 N=N*PI/4320
  194. 1500 F=0:RETURN
  195. 1598 '
  196. 1599 ' Startup screen
  197. 1600 CLS:PRINT:PRINT TAB(5);"CONLOG : Contest scoring program ver4.0 by G4PMK"
  198. 1610 PRINT:PRINT"  Inputs are accepted as either -":PRINT TAB(10);"Maidenhead Locator (eg ";HF$;"91IP),"
  199. 1620 PRINT TAB(10);"(default locator field ";HF$;" can be omitted, eg 91IP is acceptable);"
  200. 1630 PRINT TAB(7);"or European locator (eg ZL24E);"
  201. 1640 PRINT TAB(7);"or distance in kilometres. Enter 0 for a non-scoring contact."
  202. 1650 PRINT:PRINT"  Duplicate contacts are checked by comparing locator/distance input."
  203. 1660 PRINT:PRINT"  Input '-' to remove the last entry."
  204. 1670 PRINT"  'TOTAL' or 'PAGE' will give page/scoresheet totals."
  205. 1680 PRINT"  'SAVE' saves the current log table, then continues (use as backup)."
  206. 1690 PRINT"  'END' saves the current status for next time, and quits."
  207. 1700 PRINT:PRINT"  '?' will display this information again."
  208. 1710 PRINT:PRINT
  209. 1720 RETURN
  210. 16430 PRINT TAB(30);"or a distance in kilometres. Enter 0 for a non-scoring contact."
  211.